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Modified by: 


v03-004 ors Elliott A. Drayto 21-Jun-1984 
Changed code to use tSTLUN and RECORD. SIZE from SYECOM. 


v03-003 SARO278 Sharon A, Reynolds 21-Jun-1984 
Added TMSCP support. 


v03-002 SARO171 Sharon A, Reynolds, 11-Nov-1983 
= Removed the ‘b -togm gmscp’ routine 
- Changed the carriage control for use with ERF. 


v03-001 BP0001 Brian Porter, 07-SEP-1983 
Added ‘no-unit' code. 
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Functional description: 
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Subroutine LOGMSCP (Lun,record_length) 


include *src$:msghdr.for/nolist’ 
include *srcS$:embimdef.for/nolist' 
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include *src$:syecom.for/nolist’ 
byte lun 

nteger*4 record. length 

integer*2 Logmscp_t 

equ Solence (enbt ie}. logmscp. type) 
byte msc cket (476) 
equivalence (embUS6) -mscp _packet(1)) 
integere4 mscp$$b_opcode 

integereé ascp $b-endcode 
integere4 wel pose format 

integere4 packet_Tength 

integer*4 compress4 


call FRCTOF (lstlun) 

call HEADER (Lstlun) 

call LOGGER (istlun,"ERLSLOGMSCP ENTRY) 
call LOGMSCP_HEADER () 

packet_length = record_size - 36 

call LINCHK (lstlun,1) 


write(lstlun,10) 
format(' ars | 


if (logmscp_type .eq. 9) then 


mscp$$b_opcode = LibSextzv(0,7,emb(44)) 
mscp$$b_endcode = LibSextzv(6,8,emb(44)) 


call LINCHK (lstlun,1) 


write(Lstlun,15) “UNEXPECTED END MESSAGE ‘‘MSCP$W_STATUS'” 
format(' tha) 


call movcs (vol Coocker Length) ,emb(36) ,emb(38)) 
call MSCP$B_OPCODE_DISPATCHER ([stlun,mscp$$b_endcode,.true.,. false.) 


else if (logmscp_type .eq. 10) then 


mscp$$b_opcode = UibSextev(G 7,emb(44)) 
mscp$$b_endcode = | bSextzv(6,6,emb(44)) 


coit erie (tstlun,1) 
write(lstlun,15) "UNEXPECTED ATTENTION CONTROL MESSAGE‘ 


call MOVCS (Zval(packet_length) ,emb(36) ,emb(38)) 


call LINCHK Cigetun.t) 
write(istlun,10) 
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call MSCP_FIRST_TWELVE_BYTES2 (Lstlun,.true.) 
if (packet length .gt. 12) then 


seit b NCHK (istlun,1) 
write stlun,1 ) 


cot) Duwnes (Lstlun, (((packet_length = 12) + 3)/4),emb(50)) 


msig$$b_format = LibSextzv(0,7,emb(44)) 
call LINCHK (Lstlun,1) 


if ¢ 
1 msig$$b_format .eq. 0 


-or. 
1 os. eee. foract -eq. 1 
1) then 


write(istlun,15) "NO-UNIT DATAGRAM‘ 
else 


er iegttocten. 15) "DATAGRAM FOR NON-EXISTING ‘UCB’ 


Although the ‘embimdef’ format is not part of this kind of error log 
entry it is necessary. because of the implementation chosen, to zero 
the equivalent ‘emb$Sb_lm_type’ field and re-position the ‘'mscp"’ portion 
of the entry for the output routines. 


aaanaann 


call MOVCS (Zval(packet_length) ,emb(36) ,emb(38)) 
emb$Sb_lm_type = 0 


if (mslg$$b_format .eq. 0) t 


| 

} 

| 

| 

else if (lLogmscp_type .eq. 11) then 
hen 

call MSLGSK_CNT_ERR (istlun,packet_length) 


+ else if (mslg$$b_format .eq. 1) then 

: call MSLGSK_BUS_ADDR (istlun,packet_length) 

ig else if ¢ 
\3 1 mslg$$b_format .eq. 2 ! Disk transfer error 

1 1 ms g$$b_ format EQ. 5 ! Tape transfer error | 
1 | 
15 


then 
call DISK_TAPE_TRANSFER_ERRORS (istlun,packet_length) 


gtse if ¢ 
msig$$b_format .eq. 3 ! $D1 error 
ms \g$$b_ format eq. 6 ! STI error 
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! msig$$b_format .eq. 7 ! STI drive error 
: ms (988d. format -eq. 8 ! STI formatter error 


then 
call SOI_STI_ERRORS (istlun,packet_length) 
else if ios gases format .eq. 4) then ' Small disk error 
colt MSLGSK_SML_BSK (istlun,packet_Length) 
else 
call LINCHK (Lstlun,1) 
write(istlun,10) 


cot) Suwanee (Lstlun,(((packet_length) + 3)/4),emb(38)) 


The IF=THEN-ELSE should be extended at this point to add 
additional ‘‘logmscp_type’’ formats. 

else 

call LINCHK (Lstlun,1) 

write(lstlun,20) logmscp type 

tormat(® ruth. ENTRY TYPE 3° 

1 i<compress4 (LibSextzv(0,16, Logmscp_type))>.".") 

call LINCHK (Lstlun,1) 

write(lstlun,10) 

col) puwnes (istlun,(((packet_length) + 3)/4),emb(36)) 


return 
end 
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LOGMSCP 


PROGRAM SECTIONS 


ENTRY POINTS 
Address Type 
0-00000000 


VARIABLES 
Address Type 


eet 


+ 
+= 
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ARRAYS 


Name Bytes 
SCODE 79 
SPDATA 0 
SLOCAL ? 
—mB 

4 SYECOM 4 
Total Space Allocated 1822 


Name 
LOGMSCP 


of 
—— 
= 
~~ 
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Ea 
a 
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LOGSCP. TYPE 
RSCPS$B -ENDCODE 
MSLG$$B_ FORMAT 
PACKET CENGTH 
RECORD SIZE 


ALID_CPuU 
VALID~ TYPE 


Attributes 

PIC CON REL LCL SHR EXE RD NOWRT LONG 
PIC CON REL LCL SHR NOEXE RD NOWRT LONG 
PIC CON REL LCL NOSHR NOEXE D WRT LONG 
PIC OVR REL GBL SHR ia fe | RD WRT LONG 
PIC OVR REL GBL SHR NOEXE RD WRT LONG 

Address Type Name 
11780 


ERYPTK FLAG 
EMBSB th. CLASS 
$B_LM_TYPE 


FCAG™ 


 VvOzBzs en 
z2UvVOPrPuO 
— Ome 
- =somwcw bad 
2 3Ss° < 


rR 
RECORD LENGTH 

CLASS 
VALID TENTRY 
VOLUME _OUTPUT 


Dimensions 
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LOGMSCP 


LABELS 
Address Label 
1=000000A7 10° 


Address Label 
1-000000AC 15° 


FUNCTIONS AND SUBROUTINES REFERENCED 
Type Name 
1*4 ronnyees 


MOV 
MSLGSK BUS ADDR 
SD1_STT_ERRORS 


Address Label 


1-00000083 20° 


Type Name 


if 


5op-19 
-Sep-19 


DISK APE. TRANSFER_ERRORS 


nSCPSe -OPCODE DISPATCHER 


MSLGSK-CNT_ERR 


Be 94:00:08 


Type 


3.4-56 


VAX=-11 FORTRAN 
ERF. SRCILOGHSCP. FOR; 1 


D1SKSVMSMASTER: fage 


LIBSEX atv 

LOGMSCP_HEADER 

MSCP FIRST. PUELVE _BYTES2 
MSLGSK_SML_DSK 
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Subroutine LOGMSCP_HEADER () 


include *src$:msghdr.for/nolist' 

include *src$:syecom.for/nolist’ 

byte class_driver_array(4) 

integers4 class_driver 

charactert4 class Gc iver string 

equivalence (emb(T8) ,claSs_driver_array(1),class_driver_string, 
class_driver) 

integer*4 cddb$q_cntrlid_array(2) 

integers4 cddb$q_cntrlidT 

equivalence (cddb monte) Lg orveytt) .cddete_cntet iat) 

integert4 cddb$q_cntrli 

equivalence (cddb 9 cntrlid_arra tc) .cddbtq cntrlid2) 

equivalence (emb(22) ,cddb$q_cntrlid_array(1)) 

byte cddb$b_systemid_array(6) 

integer*4 cddb$b_systemidT 

integer*2 cddb$b_Systemid 

equivalence tcdab ss systemid_array(5),cddb$b_systemid2) 

equivalence (emb (30) ,cddb$b_Systemid_array(1J) 

eyte fao_array(4) 

characters4 fao_strin 


equivalence 


external 
lLogical*4 


(fad array(1), fao_string) 


sys$fao 
sys$fao 


VAX-11 FORTRAN ¥3 8-36 Page 7 
DISKSVMSMASTER: CERF .SR 


CILOGMSCP.FOR; 1 


write(istlun,10) "CLASS Er iven" .61ens_oriver 
10 format(/* ',t8,a,t24,28.8) 


if (sys$fao("!AF’,,fao_string,%val(4),class_driver_array(1))) then 
call LINCHK (Lstlun,1) 
write(lstlun 15) fao_string 

*t40,'/',a 


15 format ( hal dad 
endif 
call LINCHK (istlun,2) 


write(Lstlun,20) cddb$q_cntrlid!,cddb$q_cntrlid2 
4? CNTR ID’. toe Hi 


40 
re 20 ormat(' 35° CDDBSQ_ Fe 


2 1 t24,28. 


equivalence (cgagee Syston orray(1) cddbsb_systenidt) 
call LINCHK (Lstlun,2) 


LOGMSCP_HEADER 


PROGRAM SECTIONS 
Name 
0 SCODE 
1 SPDATA 
¢ SLOCAL 
EMB 
4 SYECOM 


Total Space Allocated 


ENTRY POINTS 
Address Type 
0-00000000 


Name 
LOGMSCP_HEADER 


VARIABLES 
Name 


“CLASS 
ENTRY 
E_OUTPUT 


ss 


vo 


igseoe198s 00:05:28 


VAX- 


cs call CDDBSQ_CNTRLID (Lstlun,cddb$q_cntlridl,cddb$q_cntrlid2) 
m4 call LINCHK (istlun,2) 
SS as Hontectpt Lene GAMRENeRURERTST Gea anysten? 

? 1 t28,24.4) 

¢ return 

4 end 


Attributes 
PIC CON REL LCL SHR XE RD NOWRT LONG 
PIC CON REL LCL SHR NOEXE RD NOWRT LONG 
PIC CON REL LCL NOSHR NOEXE RD WRT LONG 
PIC OVR REL GBL SHR NOEXE RD WRT LONG 
PIC OVR REL GBL SHR NOEXE RD WRT LONG 
ress Type Name 
Add T N 
-00000022 I*2 CDDBSB_SYSTEMID2 
-0000001 I*4 (CODB$Q CNTRLID1 
-0000001 I*4 CLASS BRIVER 
4- 88 12 Ll FN? 0 
4- 15 Let CP_11722 
4- Bh OD I*4 DEV_CHAR 
3-00000004 is EMBSW_HD_ENTRY 
4- bes a3 L*1 END_VALUE 
2- BS CHAR FAO STRING 
4- C Lei LINES 
4- 1f I*4 MAILBOX _CHANNEL 
4- 4 L*4 PRINTER 
4- I*4 RECORD_SIZE 
4- A L*l VALID_CPuU 
4-0000001C L*l VALID TYPE 


11 F 
DISKSVMS 


RAN ¥3 4-36 Page 8 
TER: LERF .SRCILOGMSCP.FOR; 1 


N 
cotati mm "Breeen 188s 92:80:68 SEEKSUMSRASTEN: TERE seecILOGHSCP.FOR:I om” 


ARRAYS 
Address Type Name Bytes Dimensions 


D_ARRAY g (6) 
ARRAY (2) 
RRAY 4 (4) 
oe (0:511) 
(2) 
4 (4) 
1-00000018 10° 1-00000025 15° 1-00000032 20' 1-G0000053 25° 


FUNCTIONS AND SUBROUTINES REFERENCED 
Type Name Type Name Type Name 
CDDBSQ_CNTRLID LINCHK L*4 SYSS$FAO 


COMMAND QUALIFIERS 
FORTRAN /LIS=L1S$:LOGMSCP/0BJ=0BJ$:LOGMSCP MSRC$:LOGMSCP 


/ CHE CK= (NOBOUNDS , OVERF LOW, NOUNDERF LOW) 
/DEBUG= (NOS YMBOL§, TRACEBACK) 

/STANDARD=(NOSYNTAX,NOSOURCE_FORM) 

/SHOW= (NOPREPROCESSOR ,NOINCLODE ,MAP) 

/F77 /NOG_FLOATING 714 /OPTIMIZE /WARNINGS /NOD_LINES /NOCROSS_REFERENCE /NOMACHINE_CODE /CONTINUATIONS=19 


COMPILATION STATISTICS 


Run Time: 4.86 seconds 
Elapsed Time: 14.09 seconds 
Page Faults: 187 

Dynamic Memory: 183 pages 


| 
Address Label Address Label Address Label Address Label 
| 
| 
| 
| 
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